home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 9 / The PC-SIG Library on CD ROM - Ninth Edition.iso / 301_400 / DISK0324 / DISK0324.ZIP / HAT.PAS < prev    next >
Pascal/Delphi Source File  |  1984-10-02  |  3KB  |  104 lines
  1. PROGRAM hat;
  2.  
  3. {  This program displays on the IBM graphics screen a plot of the 'hat'
  4. {  function.  The hat is displayed in the hi-resolution mode.
  5. {
  6. {  The program was written for Turbo Pascal.  It uses an external routine
  7. {  to perform the plot function.  This routine is held in file POINT.BIN.
  8. {  You must have set the disk default to the drive with POINT.BIN before
  9. {  compiling the program.
  10. {
  11. {  NOTE -- This program will take about an hour to run if you do not have
  12. {  an 8087 chip running with Turbo Pascal-8087 v2.0.  If you do have that
  13. {  hardware/software configuration, the program will run in under three minutes.
  14. {  You cannot halt the program with a BREAK command.  You have to warm boot
  15. {  (CONTROL-ALT-DEL) the IBM.}
  16.  
  17.  
  18. CONST
  19.   p = 310;
  20.   q = 95;
  21.   xp = 180;
  22.   yp = 50;
  23.   zp = 64;
  24.  
  25. VAR
  26.   yf,xy,zf,xf,zt,xt,xr,yr,yy,xpzp : REAL;
  27.   xp2,zi,zzp,zzq,xl,xi,yi         : INTEGER;
  28.   qq, a, zz, xx, x1, y1           : INTEGER;
  29.   aa                              : STRING[100];
  30.  
  31.       TYPE
  32.         varX = RECORD
  33.           varL,varH: BYTE;
  34.         END;
  35.         TimeRec = RECORD
  36.           AX,BX: varX;
  37.           Min,Hour,Msec,Sec: BYTE;
  38.           BP,SI,DI,DS,ES,FLAGS: INTEGER;
  39.         END;
  40.         RecPack = RECORD
  41.           AX: varX;
  42.           BX,CX,DX,BP,SI,DI,DS,ES,FLAGS: INTEGER;
  43.         END;
  44.  
  45.       VAR
  46.         intparm : RecPack;
  47.         i,j : INTEGER;
  48.         rx,ry : INTEGER;
  49.  
  50.  
  51.       PROCEDURE ShowTime;
  52.       VAR
  53.         timeparm : TimeRec;
  54.  
  55.       BEGIN
  56.         WITH TimeParm DO
  57.           BEGIN
  58.             AX.varH := $2C;
  59.             MsDos(timeparm);
  60.             WRITELN('Time is : ',Hour,':',Min,':',Sec,'.',Msec);
  61.           END;
  62.       END;
  63.  
  64.  
  65.  
  66. BEGIN
  67.   qq := 2 * q;
  68.   xr := 1.5*PI;
  69.   xf := xr/xp;
  70.   xpzp := xp/zp;
  71.   xp2 := xp*xp;
  72.   yr := 1;
  73.   yf := yp/yr;
  74.   zf := xr/zp;
  75.  
  76.   ShowTime;
  77.   HIRES; HiresColor(7);
  78.   ShowTime;
  79.   FOR zi:= -q TO q-1 DO
  80.     BEGIN
  81.       IF (zi >= -zp) AND (zi <= zp) THEN
  82.         BEGIN
  83.           zt := zi * xpzp;
  84.           zz := zi;
  85.           xl := TRUNC (0.5 + SQRT(xp2 - zt*zt));
  86.           FOR xi := - xl TO xl DO
  87.             BEGIN
  88.               xt := SQRT(xi*xi + zt*zt) * xf;
  89.               yy := (SIN(xt) + 0.4 * SIN(3 * xt)) * yf;
  90.               x1 := ROUND(xi + zz + p);
  91.               y1 := ROUND(qq - (yy - zz + q));
  92.               PLOT(x1,y1,1);
  93.             END;
  94.         END; {if}
  95.   END; {next zi}
  96.  
  97.   GOTOXY(1,2);
  98.   ShowTime;
  99.   READLN(aa);
  100.   CRTINIT;
  101.   ShowTime;
  102.  
  103. END.
  104.